home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / SystemCode / CorePackages / aemain.tcl < prev    next >
Encoding:
Text File  |  2000-12-18  |  22.7 KB  |  721 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  TclAE - AppleEvent extension for Tcl
  4.  # 
  5.  #  FILE: "aemain.tcl"
  6.  #                                    created: 1/17/00 {5:53:20 PM} 
  7.  #                                last update: 12/18/2000 {15:51:43 PM} 
  8.  #                                    version: 2.0b8
  9.  #  Author: Jonathan Guyer
  10.  #  E-mail: jguyer@his.com
  11.  #    mail: Alpha Cabal
  12.  #          POMODORO no seisan
  13.  #     www: http://www.his.com/jguyer/
  14.  #  
  15.  # ========================================================================
  16.  #               Copyright (c) 1999-2000 Jonathan Guyer
  17.  #                      All rights reserved
  18.  # ========================================================================
  19.  # Permission to use, copy, modify, and distribute this software and its
  20.  # documentation for any purpose and without fee is hereby granted,
  21.  # provided that the above copyright notice appear in all copies and that
  22.  # both that the copyright notice and warranty disclaimer appear in
  23.  # supporting documentation.
  24.  # 
  25.  # Jonathan Guyer disclaims all warranties with regard to this software,
  26.  # including all implied warranties of merchantability and fitness.  In
  27.  # no event shall Jonathan Guyer be liable for any special, indirect or
  28.  # consequential damages or any damages whatsoever resulting from loss of
  29.  # use, data or profits, whether in an action of contract, negligence or
  30.  # other tortuous action, arising out of or in connection with the use or
  31.  # performance of this software.
  32.  # ========================================================================
  33.  #  Description: 
  34.  # 
  35.  #  History
  36.  # 
  37.  #  modified   by  rev reason
  38.  #  ---------- --- --- -----------
  39.  #  2000-01-17 JEG 1.0 original
  40.  #  2000-08-28 JEG 2.0 synchronized with TclAE C shared library
  41.  # ###################################################################
  42.  ##
  43.  
  44. # ◊◊◊◊ Initialization ◊◊◊◊ #
  45.  
  46. alpha::extension tclAE 2.0b8 {
  47.     namespace eval tclAE {}
  48.     
  49.     package::addPrefsDialog tclAE
  50.     
  51.     # To use the procs in aeparse.tcl to process AppleEvents (slow!), click this
  52.     # box.||To use the TclAE.shlb to process AppleEvents (speedy!), click this
  53.     # box.
  54.     newPref flag parseAppleEventsWithTcl 0 tclAE
  55.  
  56.     set haveTclAE 0
  57.     
  58.     alpha::package require aeom
  59. } help {
  60.     file "TclAE Help"
  61. } maintainer {
  62.     "Jon Guyer" <jguyer@his.com> <http://www.his.com/jguyer/>
  63. }
  64.  
  65. proc tclAE::quitHook {} {
  66.     # tclAE::target only exists in Alpha 8
  67.     if {([llength [info commands "tclAE::target"]] == 0)
  68.     &&  ([llength [info commands "::tclAE::target"]] == 0)} {
  69.         message "Caching AE Targets…"
  70.         cache::delete tclAETargets
  71.         set i 0
  72.         foreach target [tclAE::target names] {
  73.             set targetArray "target$i"
  74.  
  75.             # Copy target information into a local array
  76.             tclAE::target info $target $targetArray
  77.  
  78.             set ${targetArray}(hashKey) $target
  79.             # Cache that array
  80.             cache::add tclAETargets variable $targetArray
  81.             
  82.             incr i
  83.             unset $targetArray
  84.         }    
  85.     }    
  86. }
  87.  
  88. # test will fail if TclAE.shlb is available to a Tcl8-based Alpha
  89. if {([info tclversion] < 8.0)
  90. ||    ![info exists tclAE_version] 
  91. ||  ($tclAE_version < 2.0)} {
  92.  
  93. tclAE::desc
  94. tclAE::coerce
  95. tclAE::loadprint
  96.  
  97. # ◊◊◊◊ TclAE calls á la ToolBox ◊◊◊◊ #
  98.  
  99. proc tclAE::build {theAEGizmo} {
  100.     tclAE::parse::obj theAEGizmo theAEDesc
  101.     
  102.     return $theAEDesc
  103. }
  104.  
  105. proc tclAE::coerceData {typeCode data toType} {
  106.     global tclAE::coerce::handler
  107.     
  108.     # no need to do anything for an identity coercion
  109.     if {($toType != $typeCode)
  110.     &&  ($toType != "****")} {
  111.         
  112.         if {[catch {tclAE::getCoercionHandler $typeCode $toType} handler]} {
  113.             if {[catch {tclAE::getCoercionHandler "****" $toType} handler]} {
  114.                 if {[catch {tclAE::getCoercionHandler $typeCode "****"} handler]} {
  115.                     # No coercion possible
  116.                     error::throwOSErr -1700
  117.                 }         
  118.             }         
  119.         } 
  120.         
  121.         set resultDesc [tclAE::createDesc $toType]
  122.         
  123.         set data [tclAE::build::_ensureBinary $data]
  124.         
  125.         if {[catch {$handler $typeCode $data $toType $resultDesc}]} {
  126.             # Coercion failed
  127.             error::throwOSErr -1700
  128.         } 
  129.     } else {
  130.         set resultDesc [tclAE::createDesc $typeCode $data]
  131.     }
  132.     
  133.     return $resultDesc
  134. }
  135.  
  136. proc tclAE::coerceDesc {theAEDesc toType} {
  137.     global errorMsg
  138.     
  139.     set fromAEDesc [tclAE::_getDescFromAny $theAEDesc]
  140.     set err [catch {
  141.         set coerceDesc [tclAE::_descriptorProc $fromAEDesc coerceDesc]
  142.         set toAEDesc [$coerceDesc $fromAEDesc $toType]
  143.     } errorMsg]
  144.     
  145.     tclAE::disposeDesc $fromAEDesc
  146.     
  147.     if {$err} {
  148.         error::rethrow
  149.     } else {
  150.         return $toAEDesc
  151.     }
  152. }
  153.  
  154. proc tclAE::countItems {theAEDescList} {
  155.     set theAEDescList [tclAE::subdesc::_getDescIfSubDesc $theAEDescList]
  156.     return [[tclAE::_descriptorProc $theAEDescList countItems] $theAEDescList]
  157. }
  158.  
  159. proc tclAE::createDesc {typeCode {data ""}} {
  160.     global tclAE::desc::_next
  161.     
  162.     # Get the next available AEDesc record
  163.     set AEDesc [tclAE::desc::_form [incr tclAE::desc::_next]]
  164.     
  165.     # Set the descriptor type
  166.     global $AEDesc
  167.     set ${AEDesc}(descriptorType)    $typeCode
  168.     set ${AEDesc}(basicType)        "****"
  169.     set ${AEDesc}(dataRecord)        [tclAE::build::_ensureBinary $data]     
  170.  
  171.     return $AEDesc    
  172. }
  173.  
  174. proc tclAE::createList {{isRecord 0}} {
  175.     if {$isRecord} {
  176.         set AEDescList [tclAE::createDesc "reco"]
  177.         global $AEDescList
  178.         set ${AEDescList}(basicType) "reco"
  179.     } else {
  180.         set AEDescList [tclAE::createDesc "list"]
  181.         set ${AEDescList}(basicType) "list"
  182.     }
  183.     
  184.     return $AEDescList
  185. }
  186.  
  187. proc tclAE::deleteItem {theAEDescList index} {
  188.     [[tclAE::_descriptorProc $theAEDescList deleteItem] \
  189.               $theAEDescList $index]
  190. }
  191.  
  192. proc tclAE::deleteKeyDesc {theAERecord theAEKeyword} {    
  193.     [[tclAE::_descriptorProc $theAERecord deleteKeyDesc] \
  194.                 $theAERecord $theAEKeyword]
  195. }
  196.  
  197. proc tclAE::disposeDesc {theAEDesc} {
  198.     return [[tclAE::_descriptorProc $theAEDesc disposeDesc] $theAEDesc]
  199. }
  200.  
  201. proc tclAE::duplicateDesc {theAEDesc} {
  202.     return [tclAE::_getDescFromAny $theAEDesc]
  203. }
  204.  
  205. proc tclAE::getCoercionHandler {fromType toType} {
  206.     global tclAE::coerce::handler
  207.  
  208.     # We ignore isSysHandler
  209.     # All handlers are application specific (for now, anyway)
  210.     if {[info exists tclAE::coerce::handler(${fromType}${toType})]} {
  211.         set handlerInfo [set tclAE::coerce::handler(${fromType}${toType})]
  212.         
  213.         return [lindex $handlerInfo 0]
  214.     } else {
  215.         # Handler undefined
  216.         error::throwOSErr -1717
  217.     }
  218. }
  219.  
  220. proc tclAE::getEventHandler {theAEEventClass theAEEventID} {
  221.     global tclAE::eventHandlers
  222.  
  223.     # We ignore isSysHandler
  224.     # All handlers are application specific (for now, anyway)
  225.     if {[info exists tclAE::eventHandlers(${theAEEventClass}${theAEEventID})]} {
  226.         set handlerInfo [set tclAE::eventHandlers(${theAEEventClass}${theAEEventID})]
  227.         
  228.         return [lindex $handlerInfo 0]
  229.     } else {
  230.         # Handler undefined
  231.         error::throwOSErr -1717
  232.     }
  233. }
  234.  
  235. proc tclAE::getKeyData {theAERecord theAEKeyword {desiredType ****} {typeCodePtr ""}} {
  236.     upvar $typeCodePtr typeCode
  237.     return [[tclAE::_descriptorProc $theAERecord getKeyData] \
  238.               $theAERecord $theAEKeyword $desiredType typeCode]
  239. }
  240.  
  241. proc tclAE::getKeyDesc {theAERecord theAEKeyword {desiredType ****}} {
  242.     return [[tclAE::_descriptorProc $theAERecord getKeyDesc] \
  243.               $theAERecord $theAEKeyword $desiredType]
  244. }
  245.  
  246. proc tclAE::getKeyGizmo {theAERecord theAEKeyword {desiredType ****}} {
  247.     set theAEDesc [tclAE::getKeyDesc $theAERecord $theAEKeyword $desiredType]
  248.     set gizmo [tclAE::print $theAEDesc]
  249.     tclAE::disposeDesc $theAEDesc
  250.     
  251.     return $gizmo
  252. }
  253.  
  254. proc tclAE::getNthData {theAEDescList index {desiredType ****} {theAEKeywordPtr ""} {typeCodePtr ""}} {
  255.     upvar $theAEKeywordPtr theAEKeyword
  256.     upvar $typeCodePtr typeCode
  257.     return [[tclAE::_descriptorProc $theAEDescList getNthData] \
  258.               $theAEDescList $index $desiredType theAEKeyword typeCode]
  259. }
  260.  
  261. proc tclAE::getNthDesc {theAEDescList index {desiredType ****} {theAEKeywordPtr ""}} {
  262.     upvar $theAEKeywordPtr theAEKeyword
  263.     return [[tclAE::_descriptorProc $theAEDescList getNthDesc] \
  264.               $theAEDescList $index $desiredType theAEKeyword]
  265. }
  266.  
  267. proc tclAE::getNthGizmo {theAEDescList index {desiredType ****} {theAEKeywordPtr ""}} {
  268.     upvar $theAEKeywordPtr theAEKeyword
  269.     
  270.     set theAEDesc [tclAE::getNthDesc $theAEDescList $index $desiredType theAEKeyword]
  271.     set gizmo [tclAE::print $theAEDesc]
  272.     tclAE::disposeDesc $theAEDesc
  273.     
  274.     return $gizmo
  275. }
  276.  
  277. proc tclAE::installCoercionHandler {fromType toType theHandler {handlerRefcon 0} {fromTypeIsDesc 0} {isSysHandler 0}} {
  278.     global tclAE::coerce::handler
  279.     
  280.     # We ignore isSysHandler
  281.     # All handlers are application specific (for now, anyway)
  282.     set tclAE::coerce::handler(${fromType}${toType}) \
  283.       [list $theHandler $handlerRefcon $fromTypeIsDesc]
  284. }
  285.  
  286. proc tclAE::installEventHandler {theAEEventClass theAEEventID handler {handlerRefcon ""} {isSysHandler 0}} {
  287.     global tclAE::eventHandlers
  288.     
  289.     set tclAE::eventHandlers(${theAEEventClass}${theAEEventID}) [list $handler $handlerRefcon $isSysHandler]
  290.     
  291.     # All events get routed through here
  292.     eventHandler $theAEEventClass $theAEEventID tclAE::_eventHandler
  293. }
  294.  
  295. proc tclAE::listDescriptors {} {
  296.     global tclAE::desc::wildcard
  297.     
  298.     return [info globals ${tclAE::desc::wildcard}]
  299. }
  300.  
  301. proc tclAE::print {theAEDesc} {
  302.     global errorMsg
  303.     
  304.     set copyAEDesc [tclAE::_getDescFromAny $theAEDesc]
  305.     set err [catch {
  306.         set printDesc [tclAE::_descriptorProc $copyAEDesc print]
  307.         set gizmo [$printDesc $copyAEDesc]
  308.     } errorMsg]
  309.     
  310.     tclAE::disposeDesc $copyAEDesc
  311.     
  312.     if {$err} {
  313.         error::rethrow
  314.     } else {
  315.         return $gizmo
  316.     }
  317. }
  318.  
  319. proc tclAE::putData {theAEDescList index typeCode data} {
  320.     set putDesc [tclAE::_descriptorProc $theAEDescList putDesc]
  321.     set theAEDesc [tclAE::createDesc $typeCode $data]
  322.     $putDesc $theAEDescList $index $theAEDesc
  323.     tclAE::disposeDesc $theAEDesc
  324. }
  325.  
  326. proc tclAE::putDesc {theAEDescList index theAEDesc} {
  327.     [tclAE::_descriptorProc $theAEDescList putDesc] \
  328.       $theAEDescList $index $theAEDesc
  329. }
  330.  
  331. proc tclAE::putKeyData {theAERecord theAEKeyword typeCode data} {
  332.     set putKeyDesc [tclAE::_descriptorProc $theAERecord putKeyDesc]
  333.     set theAEDesc [tclAE::createDesc $typeCode $data]
  334.     $putKeyDesc $theAERecord $theAEKeyword $theAEDesc
  335.     tclAE::disposeDesc $theAEDesc
  336. }
  337.  
  338. proc tclAE::putKeyDesc {theAERecord theAEKeyword theAEDesc} {
  339.     [tclAE::_descriptorProc $theAERecord putKeyDesc] \
  340.       $theAERecord $theAEKeyword $theAEDesc
  341. }
  342.  
  343. proc tclAE::removeCoercionHandler {fromType toType handler {isSysHandler 0}} {
  344.     global tclAE::coerce::handler
  345.     
  346.     # We ignore isSysHandler
  347.     # All handlers are application specific (for now, anyway)
  348.     if {[info exists tclAE::coerce::handler(${fromType}${toType})]} {
  349.         set handlerInfo [set tclAE::coerce::handler(${fromType}${toType})]
  350.         if {$handler != [lindex $handlerInfo 0]} {
  351.             # Something's wrong
  352.             error::throwOSErr -1717
  353.         } 
  354.         unset tclAE::coerce::handler(${fromType}${toType})
  355.     } else {
  356.         # Handler undefined
  357.         error::throwOSErr -1717
  358.     }
  359. }
  360.  
  361. proc tclAE::removeEventHandler {theAEEventClass theAEEventID handler {isSysHandler 0}} {
  362.     global tclAE::eventHandlers
  363.     
  364.     # We ignore isSysHandler
  365.     # All handlers are application specific (for now, anyway)
  366.     if {[info exists tclAE::eventHandlers(${theAEEventClass}${theAEEventID})]} {
  367.         set handlerInfo [set tclAE::eventHandlers(${theAEEventClass}${theAEEventID})]
  368.         if {$handler != [lindex $handlerInfo 0]} {
  369.             # Something's wrong
  370.             error::throwOSErr -1717
  371.         } 
  372.         unset tclAE::eventHandlers(${theAEEventClass}${theAEEventID})
  373.     } else {
  374.         # Handler undefined
  375.         error::throwOSErr -1717
  376.     }
  377. }
  378.  
  379. # ◊◊◊◊ TclAE Descriptors ◊◊◊◊ #
  380.  
  381. proc tclAE::getData {theAEDesc {desiredType ****} {typeCodePtr ""}} {
  382.     upvar $typeCodePtr typeCode
  383.     return [[tclAE::_descriptorProc $theAEDesc getData] \
  384.               $theAEDesc $desiredType typeCode]    
  385. }
  386.  
  387. proc tclAE::getDescType {theAEDesc} {
  388.     global $theAEDesc
  389.     if {[info exists $theAEDesc]} {
  390.         return [set ${theAEDesc}(descriptorType)]
  391.     } else {
  392.         error::throwOSErr -1701
  393.     }
  394. }
  395.  
  396. proc tclAE::replaceDescData {theAEDesc typeCode data} {
  397.     global $theAEDesc
  398.     
  399.     set ${theAEDesc}(descriptorType) $typeCode
  400.     set ${theAEDesc}(dataRecord) [tclAE::build::_ensureBinary $data]    
  401. }
  402.  
  403. proc tclAE::setDescType {theAEDesc toType} {
  404.     global $theAEDesc
  405.     
  406.     set ${theAEDesc}(descriptorType) $toType
  407. }
  408.  
  409. # ◊◊◊◊ TclAE Sub-descriptors ◊◊◊◊ #
  410.  
  411. namespace eval tclAE::subdesc {}
  412.  
  413. proc tclAE::subdesc::dispose {theAESubDesc} {
  414.     global $theAESubDesc
  415.     
  416.     if {[info exists $theAESubDesc]} {
  417.         unset $theAESubDesc
  418.     } else {
  419.         error::throwOSErr -1701 "Couldn't dispose of \"${theAESubDesc}\""
  420.     }
  421. }
  422.  
  423. proc tclAE::subdesc::fromDesc {theAEDesc {toAESubDesc ""}} {
  424.     global tclAE::subdesc::_next $theAEDesc
  425.     
  426.     if {![info exists $theAEDesc]} {
  427.         error::throwOSErr -1701 "Couldn't find \"${theAEDesc}\""
  428.     }
  429.     
  430.     if {$toAESubDesc == ""} {
  431.         # Get the next available AESubDesc record
  432.         set toAESubDesc [tclAE::subdesc::_form [incr tclAE::subdesc::_next]]        
  433.     } 
  434.     
  435.     global $toAESubDesc
  436.     
  437.     set ${toAESubDesc}(subDescType) [set ${theAEDesc}(descriptorType)]
  438.  
  439.     if {[set ${theAEDesc}(basicType)] == "reco"} {
  440.         set ${toAESubDesc}(basicType) "reco"
  441.     } else {
  442.         set ${toAESubDesc}(basicType) [set ${theAEDesc}(descriptorType)]
  443.     }
  444.     
  445.     # This is not how AESubDesc's are structured, but it's what
  446.     # makes the most sense here
  447.     set ${toAESubDesc}(dataHandle)  $theAEDesc      
  448.  
  449.     return $toAESubDesc
  450. }
  451.  
  452. proc tclAE::subdesc::getBasicType {theAESubDesc} {
  453.     global $theAESubDesc
  454.     
  455.     return [set ${theAESubDesc}(basicType)]
  456. }
  457.  
  458. proc tclAE::subdesc::getData {theAESubDesc {asRawBinary 0}} {
  459.     global $theAESubDesc
  460.     
  461.     set theAEDesc [set ${theAESubDesc}(dataHandle)]
  462.     global $theAEDesc
  463.     
  464.     if {$asRawBinary} {
  465.         return [tclAE::getData $theAEDesc ????]
  466.     } else {
  467.         return [tclAE::getData $theAEDesc]
  468.     }
  469. }
  470.  
  471. proc tclAE::subdesc::getKey {theAESubDesc theAEKeyword {inPlace 0}} {
  472.     global $theAESubDesc
  473.     
  474.     if {![tclAE::subdesc::isListOrRecord $theAESubDesc]} {
  475.         error::throwOSErr -1703
  476.     }
  477.     
  478.     set theAEDesc [set ${theAESubDesc}(dataHandle)]
  479.     global $theAEDesc
  480.     
  481.     set theAEKeyword [format "%-4.4s" $theAEKeyword]
  482.     
  483.     if {![info exists ${theAEDesc}($theAEKeyword)]} {
  484.         error::throwOSErr -1719 "Couldn't get sub-descriptor"
  485.     }
  486.     
  487.     if {$inPlace} {
  488.         return [tclAE::subdesc::fromDesc [set ${theAEDesc}($theAEKeyword)] $theAESubDesc]
  489.     } else {
  490.         return [tclAE::subdesc::fromDesc [set ${theAEDesc}($theAEKeyword)]]
  491.     }
  492. }
  493.  
  494. proc tclAE::subdesc::getKeyData {theAESubDesc theAEKeyword {asRawBinary 0}} {
  495.     global $theAESubDesc
  496.     
  497.     if {![tclAE::subdesc::isListOrRecord $theAESubDesc]} {
  498.         error::throwOSErr -1703 "Couldn't get sub-descriptor"
  499.     }
  500.     
  501.     set theAEDesc [set ${theAESubDesc}(dataHandle)]
  502.     global $theAEDesc
  503.     
  504.     if {$asRawBinary} {
  505.         return [tclAE::getKeyData $theAEDesc $theAEKeyword ????]
  506.     } else {
  507.         return [tclAE::getKeyData $theAEDesc $theAEKeyword]
  508.     }
  509. }
  510.  
  511. proc tclAE::subdesc::getNth {theAESubDesc index {keyIfAnyPtr ""} {inPlace 0}} {
  512.     global $theAESubDesc
  513.     
  514.     if {![tclAE::subdesc::isListOrRecord $theAESubDesc]} {
  515.         error::throwOSErr -1703 "Couldn't get sub-descriptor"
  516.     }
  517.     
  518.     upvar \#0 [set ${theAESubDesc}(dataHandle)] theAEDescList
  519.     
  520.     set data $theAEDescList(dataRecord)
  521.     if {($index < 0) 
  522.     ||  ($index >= [llength $data])} {
  523.         # index out of range
  524.         error::throwOSErr -1719 "Couldn't get sub-descriptor"
  525.     } 
  526.     upvar $keyIfAnyPtr theAEKeyword    
  527.     
  528.     if {[set ${theAESubDesc}(basicType)] == "list"} {
  529.         set theAEKeyword "****"
  530.         set item [lindex $data $index]
  531.     } else { # 'reco'
  532.         set theAEKeyword [format "%-4.4s" [lindex $data $index]]
  533.         set item $theAEDescList($theAEKeyword)
  534.     }
  535.     
  536.     if {$inPlace} {
  537.         return [tclAE::subdesc::fromDesc $item $theAESubDesc]        
  538.     } else {
  539.         return [tclAE::subdesc::fromDesc $item]        
  540.     } 
  541. }
  542.  
  543. proc tclAE::subdesc::getNthData {theAESubDesc index {keyIfAnyPtr ""} {asRawBinary 0}} {
  544.     global $theAESubDesc
  545.     
  546.     if {![tclAE::subdesc::isListOrRecord $theAESubDesc]} {
  547.         error::throwOSErr -1703 "Couldn't get sub-descriptor"
  548.     }
  549.     
  550.     set theAEDesc [set ${theAESubDesc}(dataHandle)]
  551.     global $theAEDesc
  552.     
  553.     upvar $keyIfAnyPtr theAEKeyword    
  554.     
  555.     if {$asRawBinary} {
  556.         return [tclAE::getNthData $theAEDesc $index ???? theAEKeyword]
  557.     } else {
  558.         return [tclAE::getNthData $theAEDesc $index **** theAEKeyword]
  559.     }
  560. }
  561.  
  562. proc tclAE::subdesc::getType {theAESubDesc} {
  563.     global $theAESubDesc
  564.     
  565.     if {[info exists $theAESubDesc]} {
  566.         return [set ${theAESubDesc}(subDescType)]
  567.     } else {
  568.         error::throwOSErr -1701
  569.     }
  570. }
  571.  
  572. proc tclAE::subdesc::isListOrRecord {theAESubDesc} {
  573.     global $theAESubDesc
  574.     
  575.     if {![tclAE::subdesc::isSubDescriptor $theAESubDesc]} {
  576.         error::throwOSErr -1701 "Couldn't find \"${theAESubDesc}\""
  577.     } 
  578.     
  579.     set basicType [set ${theAESubDesc}(basicType)]
  580.     
  581.     return [expr {($basicType == "list") 
  582.                || ($basicType == "reco") 
  583.                || ($basicType == "aevt")}]
  584. }
  585.  
  586. proc tclAE::subdesc::listSubDescriptors {} {
  587.     global tclAE::subdesc::wildcard
  588.     
  589.     return [info globals ${tclAE::subdesc::wildcard}]
  590. }
  591.  
  592. proc tclAE::subdesc::toDesc {theAESubDesc {desiredType ****}} {
  593.     global $theAESubDesc
  594.     
  595.     if {![tclAE::subdesc::isSubDescriptor $theAESubDesc]} {
  596.         error::throwOSErr -1701 "Couldn't find \"${theAESubDesc}\""
  597.     } 
  598.     
  599.     return [tclAE::coerceDesc [set ${theAESubDesc}(dataHandle)] $desiredType]
  600. }
  601.  
  602. # The list-oriented calls that follow make sure the subdescriptor is a
  603. # valid list or (possibly coerced) record.  If not, they'll throw
  604. # errAEWrongDataType.
  605.  
  606. # ◊◊◊◊ Private Routines ◊◊◊◊ #
  607.  
  608. proc tclAE::_descriptorProc {AEDesc procType} {
  609.     global $AEDesc tclAE::desc::procs
  610.     
  611.     if {![info exists $AEDesc]} {
  612.         error::throwOSErr -1701 "Cannot '${procType}' with \"${AEDesc}\""
  613.     }
  614.     
  615.     set descriptorType    [set ${AEDesc}(descriptorType)]
  616.     set basicType    [set ${AEDesc}(basicType)]
  617.     
  618.     if {[info exists tclAE::desc::procs(${descriptorType}.${procType})]} {
  619.         # Return type-specific proc
  620.         return [set tclAE::desc::procs(${descriptorType}.${procType})]
  621.     } elseif {[info exists tclAE::desc::procs(${basicType}.${procType})]} {
  622.         # Return generic proc
  623.         return [set tclAE::desc::procs(${basicType}.${procType})]
  624.     } else {
  625.         # No proc available
  626.         error "Cannot '${procType}' with \"${AEDesc}\""
  627.     }
  628. }
  629.  
  630. proc tclAE::_duplicateDesc {theAEDesc} {
  631.     return [[tclAE::_descriptorProc $theAEDesc duplicateDesc] $theAEDesc]
  632. }
  633.  
  634. proc tclAE::_getDescFromAny {someAEDesc} {
  635.     if {[tclAE::desc::isDescriptor $someAEDesc]} {
  636.         set theAEDesc [tclAE::_duplicateDesc $someAEDesc]
  637.     } elseif {[tclAE::subdesc::isSubDescriptor $someAEDesc]} {
  638.         set theAEDesc [tclAE::subdesc::toDesc $someAEDesc]
  639.     } else {
  640.         # assume it's an AEGizmo
  641.         set theAEDesc [tclAE::build $someAEDesc]
  642.     }
  643.     
  644.     return $theAEDesc
  645. }
  646.  
  647. proc tclAE::_eventHandler {str} {
  648.     global tclAE::eventHandlers
  649.     
  650.     set theEvent [tclAE::parse::event $str]
  651.     
  652.     global $theEvent
  653.     set eventClass [set ${theEvent}(evcl)]
  654.     set eventID [set ${theEvent}(evid)]
  655.  
  656.     if {[catch {set handlerInfo [set tclAE::eventHandlers(${eventClass}${eventID})]}]} {
  657.         tclAE::subdesc::dispose $subDesc
  658.         error::throwOSErr -1717
  659.     }
  660.     
  661.     set theAESubDesc [tclAE::subdesc::fromDesc $theEvent]
  662.     
  663.     # Unused by this code. Here for compatibility with Alpha 8.
  664.     set theReply [tclAE::createList 1]
  665.     
  666.     set result [eval [lindex $handlerInfo 0] $theAESubDesc $theReply]
  667.     
  668.     tclAE::disposeDesc $theEvent
  669.     tclAE::subdesc::dispose $theAESubDesc
  670.     
  671.     # Alpha <8 cannot send replies, so throw it away 8^(
  672.     tclAE::disposeDesc $theReply
  673.     
  674.     return $result
  675. }
  676.  
  677. proc tclAE::subdesc::_getDescIfSubDesc {theAESubDesc} {
  678.     if {[tclAE::subdesc::isSubDescriptor $theAESubDesc]} {
  679.         global $theAESubDesc
  680.         return [set ${theAESubDesc}(dataHandle)]
  681.     } else {
  682.         return $theAESubDesc
  683.     }
  684. }
  685.  
  686. proc tclAE::getAttributeData {&theAppleEvent theAEKeyword desiredType &typeCode dataPtr maximumSize &actualSize} {beep; message "tclAE::getAttribute not implemented"}
  687. proc tclAE::getAttributeDesc {&theAppleEvent AEKeyword desiredType &result} {beep; message "tclAE::getAttributeDesc not implemented"}
  688.  
  689. }
  690.  
  691. # ◊◊◊◊ unimplemented AEM calls ◊◊◊◊ #
  692.  
  693. proc tclAE::createAppleEvent {theAEEventClass theAEEventID &target returnID transactionID &result} {beep; message "tclAE::createAppleEvent not implemented"}
  694. proc tclAE::deleteParam {&theAppleEvent theAEKeyword} {beep; message "tclAE::deleteParam not implemented"}
  695. proc tclAE::getArray {&theAEDescList arrayType arrayPtr maximumSize &itemType &itemSize itemCount} {beep; message "tclAE::getArray not implemented"}
  696. proc tclAE::getInteractionAllowed {&level} {beep; message "tclAE::getInteractionAllowed not implemented"}
  697. proc tclAE::getParamDesc {&theAppleEvent AEKeyword desiredType &result} {beep; message "tclAE::getParamDesc not implemented"}
  698. proc tclAE::getParamPtr {&theAppleEvent theAEKeyword desiredType &typeCode dataPtr maximumSize &actualSize} {beep; message "tclAE::getParamPtr not implemented"}
  699. proc tclAE::getSpecialHandler {functionClass &handler isSysHandler} {beep; message "tclAE::getSpecialHandler not implemented"}
  700. proc tclAE::getTheCurrentEvent {&theAppleEvent} {beep; message "tclAE::getTheCurrentEvent not implemented"}
  701. proc tclAE::installSpecialHandler {functionClass handler isSyshandler} {beep; message "tclAE::installSpecialHandler not implemented"}
  702. proc tclAE::interactWithUser {timeOutInTicks nmReqPtr idleProc} {beep; message "tclAE::interactWithUser not implemented"}
  703. proc tclAE::processAppleEvent {&theEventRecord} {beep; message "tclAE::processAppleEvent not implemented"}
  704. proc tclAE::putArray {&theAEDescList arrayType arrayPtr itemType itemSize itemCount} {beep; message "tclAE::putArray not implemented"}
  705. proc tclAE::putAttributeDesc {&theAppleEvent theAEKeyword &theAEDesc} {beep; message "tclAE::putAttributeDesc not implemented"}
  706. proc tclAE::putAttributePtr {&theAppleEvent theAEKeyword typeCode dataPtr dataSize} {beep; message "tclAE::putAttributePtr not implemented"}
  707. proc tclAE::putParamDesc {&theAppleEvent theAEkeyword &theAEDesc} {beep; message "tclAE::putParamDesc not implemented"}
  708. proc tclAE::putParamPtr {&theAppleEvent theAEKeyword typeCode dataPtr dataSize} {beep; message "tclAE::putParamPtr not implemented"}
  709. proc tclAE::removeSpecialHandler {functionClass handler isSysHandler} {beep; message "tclAE::removeSpecialHandler not implemented"}
  710. proc tclAE::resetTimer {&reply} {beep; message "tclAE::resetTimer not implemented"}
  711. proc tclAE::resumeTheCurrentEvent {&theAppleEvent &reply dispatcher handlerRefcon} {beep; message "tclAE::resumeTheCurrentEvent not implemented"}
  712. proc tclAE::setInteractionAllowed {level} {beep; message "tclAE::setInteractionAllowed not implemented"}
  713. proc tclAE::setTheCurrentEvent {&theAppleEvent} {beep; message "tclAE::setTheCurrentEvent not implemented"}
  714. proc tclAE::sizeOfAttribute {&theAppleEvent theAEKeyword &typeCode &dataSize} {beep; message "tclAE::sizeOfAttribute not implemented"}
  715. proc tclAE::sizeOfKeyDesc {&theAERecord theAEKeyword &typeCode &dataSize} {beep; message "tclAE::sizeOfKeyDesc not implemented"}
  716. proc tclAE::sizeOfNthItem {&theAEDescList index &typeCode &dataSize} {beep; message "tclAE::sizeOfNthItem not implemented"}
  717. proc tclAE::sizeOfParam {&theAEEvent theAEKeyword &typeCode &dataSize} {beep; message "tclAE::sizeOfParam not implemented"}
  718. proc tclAE::suspendTheCurrentEvent {&theAppleEvent} {beep; message "tclAE::suspendTheCurrentEvent not implemented"}
  719.  
  720.  
  721.